home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.04 Apr 93 / Metaprogramming PostScript.sea / Metaprogramming PostScript
Encoding:
Text File  |  1993-05-04  |  9.7 KB  |  471 lines  |  [TEXT/ttxt]
  1. %%
  2. %Metaprogramming PostScript: A System for Arbitrary Diagnostic Analysis 
  3. %This text is Copyright 1992 Gregory Koomey.  All rights are reserved;  
  4. %nothing herein shall be used without written consent from the author.
  5.  
  6. %Listing 1 
  7.  
  8. %%begin utility dict definition
  9. 20 dict dup begin 
  10. /utility exch def %internal identity of dict
  11. /outfile (Horatio:Programming:Qued/M:quark outfile) (w) file def
  12.  
  13. %in case of error, the following code closes outfile
  14. %/*handleerror errordict /handleerror get def
  15. %errordict begin 
  16. %    /handleerror { 
  17. %        outfile closefile
  18. %    *handleerror
  19. %        } bind def
  20. %    end %%errordict
  21. %%end of error handling code
  22.  
  23. /thesysdict systemdict def %to keep original systemdict available
  24. /workstring 100 string def
  25.  
  26. %some useful procedures
  27. /comment
  28.     {outfile (Comment: ) writestring 
  29.     outfile exch writestring
  30.     outfile (\r) writestring} bind def
  31. /makestring 
  32.     {workstring cvs dup length string copy} bind def
  33. /dostack %inverted destructive stack print
  34.     {outfile (dostack: ) writestring
  35.     count
  36.     {writeobj outfile ( ) writestring}
  37.     repeat
  38.     outfile (\r) writestring} bind def
  39.  
  40. %%The following are included for the complex compiler model
  41. /writeobj % depends on the following dictionary definition
  42.     {dup type dup writeobjdict exch known
  43.         {writeobjdict exch get exec} %
  44.         {workstring cvs outfile exch writestring pop} ifelse
  45.         } bind def
  46. 14 dict dup /writeobjdict exch def
  47. begin
  48. /arraytype    {xcheck    { outfile (-executable-arraytype- ) writestring}
  49.             { outfile (-arraytype- ) writestring}ifelse
  50.             } bind def
  51. /booleantype    {workstring cvs outfile exch writestring
  52.             outfile ( ) writestring} bind def
  53. /dicttype        {pop outfile (-dicttype- ) writestring} bind def
  54. /filetype        {pop outfile (-filetype- ) writestring} bind def
  55. /fonttype    {pop outfile (-fonttype- ) writestring} bind def
  56. /integertype    {workstring cvs outfile exch writestring
  57.             outfile ( ) writestring} bind def
  58. /marktype    {pop outfile (-marktype- ) writestring} bind def
  59. /nametype    {outfile (/) writestring
  60.             workstring cvs outfile exch writestring
  61.             outfile ( ) writestring} bind def
  62. /nulltype    {pop outfile (-nulltype- ) writestring} bind def
  63. /operatortype    {pop outfile (-operatortype- )  writestring} bind def
  64. /packedarraytype    {xcheck    {outfile (-executable-packedarraytype- ) writestring}
  65.             {outfile (-packedarraytype- ) writestring} ifelse
  66.             } bind def
  67. /realtype        {workstring cvs outfile exch writestring
  68.             outfile ( ) writestring} bind def
  69. /savetype    {pop outfile (-savetype- ) writestring} bind def
  70. /stringtype    {dup rcheck not
  71.             {pop outfile (\() writestring
  72.             outfile (-string-with-no-read-access- ) writestring
  73.             outfile (\)) writestring
  74.             outfile ( ) writestring}
  75.             {outfile (\() writestring
  76.             outfile exch writestring
  77.             outfile (\)) writestring
  78.             outfile ( ) writestring } ifelse 
  79.             } bind def
  80. end%writeobjdict 
  81.  
  82. /dictdump
  83.     {
  84.     exch writeobj writeobj
  85.     outfile (\r) writestring
  86.     } bind def
  87.  
  88.  
  89. /writename    
  90.     {
  91.     outfile /dummy writestring
  92.     outfile (\r) writestring
  93.     } bind def
  94. /combineprocs %takes two procs,  returns combined proc
  95.     {
  96.     mark
  97.     counttomark  2 add index
  98.     aload pop
  99.     counttomark 1 add index
  100.     aload pop counttomark packedarray cvx
  101.     4 1 roll pop pop pop
  102.     } bind def
  103.  
  104. /compile1 
  105.     {
  106.     dup 
  107.     type dup  /packedarraytype ne
  108.         {/arraytype eq}
  109.         {pop true} ifelse
  110.     {
  111.     dup xcheck
  112.         {
  113.         dup rcheck
  114.             {
  115.             exch dup 3 1 roll makestring
  116.             /writename load 1 
  117.             3 2 roll put
  118.             /writename load exch combineprocs
  119.             2 index 4 1 roll put
  120.             }
  121.             {
  122.             /outfile load
  123.             3 -1 roll dup 4 1 roll makestring
  124.             /writestring load
  125.             /outfile load
  126.             (\r)
  127.             /writestring load
  128.             7 -1 roll 
  129.             thesysdict /exec get 
  130.             8 packedarray 
  131.             cvx
  132.             3 -1 roll dup 4 2 roll
  133.             put
  134.             } ifelse
  135.  
  136.         } 
  137.         {pop pop} ifelse
  138.     }
  139.     {
  140.     dup type /operatortype eq
  141.         {
  142.         /outfile load
  143.         3 -1 roll dup 4 1 roll makestring
  144.         /writestring load
  145.         /outfile load
  146.         (\r)
  147.         /writestring load
  148.         7 -1 roll 
  149.         7 packedarray %
  150.         cvx
  151.         3 -1 roll dup 4 2 roll
  152.         put
  153.         } 
  154.         {pop pop}
  155.         ifelse
  156.     }
  157.     ifelse
  158.     } bind def
  159.  
  160.  
  161. /compile2 {    
  162.     numberdict exch get  exch 
  163.     dup 3 1 roll %copy of key at bottom of stack
  164.     dup dict2 exch known
  165.     {
  166.     dict2 exch get
  167.     combineprocs
  168.     dict2 3 1 roll put
  169.     }
  170.     {
  171.     workstring cvs outfile exch writestring
  172.     outfile ( ... is not known in dict\r) writestring
  173.     pop
  174.     pop
  175.     }
  176.     ifelse
  177.  
  178. } bind def
  179.  
  180. %%end of utility dict definition
  181.  
  182.  (end of systemdict listing) comment
  183. %%beginning of code specifically for duplication of systemdict
  184. systemdict length dict dup /dict2 exch def%the arbitrary name used here for our dict is /dict2
  185. systemdict {3 -1 roll dup 4 2 roll put} forall %
  186. dup 
  187. dup /systemdict exch put %redefine systemdict entry
  188.  
  189. %two special operation definitions which may or may not be necessary
  190. %dup 
  191. %/load %offered a key as operand
  192. %    {dup thesysdict exch known 
  193. %        {thesysdict exch dup 3 1 roll get
  194. %            type /operatortype ne
  195. %            {load} if
  196. %        }        
  197. %        {load} ifelse
  198. %    } bind put
  199.  
  200. %dup
  201. %/get %offered a dict and key as operand
  202. %    { exch dup 3 1 roll
  203. %    systemdict eq
  204. %        {thesysdict exch dup 3 1 roll get
  205. %        type /operatortype eq
  206. %            {exch pop}
  207. %            {get} ifelse
  208. %        }
  209. %        {get} ifelse
  210. %    } bind put
  211.  
  212. %%end of code specifically for duplication of systemdict
  213.  
  214.  
  215. dup
  216. {compile1}
  217. forall
  218.  
  219. pop
  220.  
  221. % code to list dict2 in outfile as /name object/type
  222. (the following is a listing of dict2) comment
  223. systemdict 
  224. {dictdump}
  225.  forall
  226.  (end of listing of dict2) comment
  227.  
  228. 6 dict dup /numberdict exch def begin
  229. /1     { 
  230.     dup writeobj outfile ( ) writestring
  231.     } bind def
  232. /2     { 
  233.     2 copy exch writeobj outfile ( ) writestring
  234.      writeobj outfile ( ) writestring
  235.     } bind def
  236. /3     {
  237.     3 copy 3 -1 roll writeobj outfile ( ) writestring
  238.     exch writeobj outfile ( ) writestring
  239.     writeobj outfile ( ) writestring
  240.     } bind def
  241. /4     { 
  242.     4 copy 4 -1 roll writeobj outfile ( ) writestring
  243.     3 -1 roll writeobj outfile ( ) writestring
  244.     exch writeobj outfile ( ) writestring
  245.      writeobj outfile ( ) writestring
  246.     } bind def
  247. /5     { 
  248.     5 copy 5 -1 roll writeobj outfile ( ) writestring
  249.     4 -1 roll writeobj outfile ( ) writestring
  250.     3 -1 roll writeobj outfile ( ) writestring
  251.     exch writeobj outfile ( ) writestring
  252.      writeobj outfile ( ) writestring
  253.     } bind def
  254. /6     { 
  255.     6 copy 6 -1 roll writeobj outfile ( ) writestring
  256.     5 -1 roll writeobj outfile ( ) writestring
  257.     4 -1 roll writeobj outfile ( ) writestring
  258.     3 -1 roll writeobj outfile ( ) writestring
  259.     exch writeobj outfile ( ) writestring
  260.     writeobj outfile ( ) writestring
  261.     } bind def
  262.  
  263. end%numberdict
  264.  
  265. %Listing 2
  266. 165 dict  dup
  267. /dict3 exch def 
  268. begin
  269. %math ops
  270. /add        /2    def
  271. /div        /2    def
  272. /idiv        /2    def
  273. /mod        /2    def
  274. /mul        /2    def
  275. /sub        /2    def
  276. /abs        /1    def
  277. /neg        /1    def
  278. /ceiling        /1    def
  279. /floor        /1    def
  280. /round        /1    def
  281. /truncate        /1    def
  282. /sqrt        /1    def
  283. /atan        /2    def
  284. /cos        /1    def
  285. /sin        /1    def
  286. /exp        /2    def
  287. /ln        /1    def
  288. /log        /1    def
  289. /srand        /1    def
  290. %array ops
  291. /array        /1    def
  292. /length        /1    def 
  293. /get        /2    def
  294. /put        /3    def
  295. /getinterval    /3    def
  296. /putinterval    /3    def
  297. /astore        /1    def
  298. /aload        /1    def
  299. /copy        /2    def
  300. /forall        /2    def
  301. %packedarray ops
  302. /packedarray    /1    def
  303. /setpacking    /1    def
  304. %Dict ops
  305. /dict        /1    def
  306. /maxlength    /1    def
  307. /begin        /1    def
  308. /load        /1    def
  309. /known        /2    def
  310. /where        /1    def
  311. /copy        /2    def
  312. /dictstack    /1    def
  313. %string ops
  314. /string        /1    def
  315. /anchorsearch    /2    def
  316. /search        /2    def
  317. /token        /1    def
  318. %boolean ops
  319. /eq        /2    def
  320. /ne        /2    def
  321. /ge        /2    def
  322. /gt        /2    def
  323. /le        /2    def
  324. /lt        /2    def
  325. /and        /2    def
  326. /not        /1    def
  327. /or        /2    def
  328. /xor        /2    def
  329. /bitshift        /2    def
  330. %control ops
  331. /exec        /1    def
  332. /if        /2    def
  333. /ifelse        /3    def
  334. /for        /4    def
  335. /repeat        /2    def
  336. /loop        /1    def
  337. /stopped        /1    def
  338. /execstack    /1    def
  339. %type ops
  340. /type        /1    def
  341. /cvlit        /1    def
  342. /cvx        /1    def
  343. /xcheck        /1    def
  344. /executeonly    /1    def
  345. /noaccess    /1    def
  346. /readonly    /1    def
  347. /rcheck        /1    def
  348. /wcheck        /1    def
  349. /cvi        /1    def
  350. /cvn        /1    def
  351. /cvr        /1    def
  352. /cvrs        /3    def
  353. /cvs        /2    def
  354. %file ops
  355. /file        /2    def
  356. /closefile    /1    def
  357. /read        /1    def
  358. /write        /2    def
  359. /readhexstring    /2    def
  360. /writehexstring    /2    def
  361. /readstring    /2    def
  362. %/writestring    /2    def %might duplicate output
  363. /readline        /2    def
  364. /token        /1    def
  365. /bytesavailable    /1    def
  366. /flushfile    /1    def
  367. /resetfile        /1    def
  368. /status        /1    def
  369. /run        /1    def
  370. /print        /1    def %might duplicate output, depending on setup...
  371. %VM ops
  372. /restore        /1    def
  373. %gstate ops
  374. /setlinewidth    /1    def
  375. /setlinecap    /1    def
  376. /setlinejoin    /1    def
  377. /setmiterlimit    /1    def
  378. /setdash        /2    def
  379. /setflat        /1    def
  380. /setgray        /1    def
  381. /sethsbcolor    /3    def
  382. /setrgbcolor    /3    def
  383. /setscreen    /3    def
  384. /settransfer    /1    def
  385. %coord system and matrix ops
  386. /identmatrix    /1    def
  387. /defaultmatrix    /1    def
  388. /currentmatrix    /1    def
  389. /setmatrix    /1    def
  390. /translate    /2    def %sometimes /3
  391. /scale        /2    def %sometimes /3
  392. /rotate        /1    def
  393. /concat        /1    def
  394. /concatmatrix    /3    def
  395. /transform    /2    def%sometimes /3
  396. /dtransform    /2    def%sometimes /3
  397. /itransform    /2    def%sometimes /3
  398. /idtransform    /2    def%sometimes /3
  399. /invertmatrix    /2    def
  400. %path construction
  401. /moveto        /2    def
  402. /rmoveto    /2    def
  403. /lineto        /2    def
  404. /rlineto        /2    def
  405. /arc        /5    def
  406. /arcn        /5    def
  407. /arcto        /5    def
  408. /curveto        /6    def
  409. /rcurveto    /6    def
  410. /charpath    /2    def
  411. /pathforall    /4    def
  412. %paint 
  413. /image        /5    def
  414. /imagemask    /5    def
  415. %device setup and output
  416. /banddevice    /4    def
  417. /framedevice    /4    def
  418. /renderbands    /1    def
  419. %character and font
  420. /definefont    /2    def
  421. /findfont        /1    def
  422. /scalefont    /2    def
  423. /makefont    /2    def
  424. /setfont        /1    def
  425. /show        /1    def
  426. /ashow        /3    def
  427. /widthshow    /4    def
  428. /awidthshow    /6    def
  429. /kshow        /2    def
  430. /stringwidth    /1    def
  431. %font cache ops
  432. /setcachedevice    /6    def
  433. /setcharwidth    /2    def
  434. /setcachelimit    /1    def
  435. /setcacheparams    /3    def
  436. %stack manipulation ops
  437. /pop        /1    def
  438. /exch        /2    def
  439. /dup        /1    def
  440. /copy        /2    def
  441. /index        /1    def
  442. /roll        /2    def
  443.  
  444. %needs to be at end of definition of dict
  445.  
  446. /bind        /1    def
  447. /def        /2    def
  448. end %dict is in utility dict under dict3
  449. %
  450. (end of dict3 definition\r) comment
  451.  
  452.  
  453. dict3    %procedure requires that dict to be modified is in utility as dict2
  454. {compile2} 
  455. forall
  456.  
  457. (this is the end of the dict redefinition...\r) comment
  458.  
  459. %Systemdict Finish
  460. dict2 begin
  461. userdict begin
  462.  
  463. (the following is a listing of dict2, after n-ary stuff added) comment
  464. systemdict 
  465. {dictdump}
  466.  forall
  467.  (end of listing of dict2, after n-ary stuff added) comment
  468.  
  469. (this is the beginning of redefined environment...\r) comment
  470. %%
  471.